home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / debug.bas < prev    next >
BASIC Source File  |  1997-06-14  |  3KB  |  109 lines
  1. Attribute VB_Name = "MDebug"
  2. Option Explicit
  3.  
  4. '$ Uses UTILITY.BAS
  5.  
  6. Private iLogFile As Integer
  7.  
  8. Private secFreq As Currency
  9.  
  10. ' Output flags determine output destination of BugAsserts and messages
  11. #Const afLogfile = 1
  12. #Const afMsgBox = 2
  13. #Const afDebugWin = 4
  14. #Const afAppLog = 8
  15.  
  16. Function BugInit() As Boolean
  17.     BugInit = QueryPerformanceCounter(secFreq)
  18. End Function
  19.  
  20. ' Display appropriate error message, and then stop
  21. ' program.  These errors should NOT be possible in
  22. ' shipping product.
  23. Sub BugAssert(ByVal fExpression As Boolean, _
  24.               Optional sExpression As String)
  25. #If afDebug Then
  26.     If fExpression Then Exit Sub
  27.     BugMessage "BugAssert failed: " & sExpression
  28.     Stop
  29. #End If
  30. End Sub
  31.     
  32.     
  33. Sub BugMessage(sMsg As String)
  34. #If afDebug And afLogfile Then
  35.     If iLogFile = 0 Then
  36.         iLogFile = FreeFile
  37.         ' Warning: multiple instances can overwrite log file
  38.         Open App.ExeName & ".DBG" For Output Shared As iLogFile
  39.         ' Challenge: Rewrite to give each instance its own log file
  40.     End If
  41.     Print #iLogFile, sMsg
  42. #End If
  43. #If afDebug And afMsgBox Then
  44.     MsgBox sMsg
  45. #End If
  46. #If afDebug And afDebugWin Then
  47.     Debug.Print sMsg
  48. #End If
  49. #If afDebug And afAppLog Then
  50.     App.LogEvent sMsg
  51. #End If
  52. End Sub
  53.  
  54. Sub BugLocalMessage(sMsg As String)
  55. #If fDebugLocal Then
  56.     BugMessage sMsg
  57. #End If
  58. End Sub
  59.  
  60. Sub BugTerm()
  61. #If afDebug And afLogfile Then
  62.     ' Close log file
  63.     Close iLogFile
  64. #End If
  65. End Sub
  66.  
  67. Sub ProfileStart(secStart As Currency)
  68.     If secFreq = 0 Then QueryPerformanceFrequency secFreq
  69.     QueryPerformanceCounter secStart
  70. End Sub
  71.  
  72. Sub ProfileStop(secStart As Currency, secTiming As Currency)
  73.     QueryPerformanceCounter secTiming
  74.     If secFreq = 0 Then
  75.         secTiming = 0 ' Handle no high-resolution timer
  76.     Else
  77.         secTiming = (secTiming - secStart) / secFreq
  78.     End If
  79. End Sub
  80.  
  81. Sub ProfileStopMessage(sOutput As String, sPrefix As String, _
  82.                        secStart As Currency, sPost As String)
  83. #If afDebug Then
  84.     Static secTiming As Currency
  85.     QueryPerformanceCounter secTiming
  86.     If secFreq = 0 Then
  87.         secTiming = 0 ' Handle no high-resolution timer
  88.     Else
  89.         secTiming = (secTiming - secStart) / secFreq
  90.     End If
  91.     ' Return through parameter so that routine can be Sub
  92.     sOutput = sPrefix & secTiming & sPost
  93. #End If
  94. End Sub
  95.  
  96. Sub BugProfileStop(sPrefix As String, secStart As Currency)
  97. #If afDebug Then
  98.     Static secTiming As Currency
  99.     QueryPerformanceCounter secTiming
  100.     If secFreq = 0 Then
  101.         secTiming = 0 ' Handle no high-resolution timer
  102.     Else
  103.         secTiming = secTiming - secStart / secFreq
  104.     End If
  105.     BugMessage sPrefix & secTiming & " sec "
  106. #End If
  107. End Sub
  108.  
  109.